home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / m68_comex.t < prev    next >
Text File  |  1988-05-02  |  3KB  |  47 lines

  1. (herald m68_comex (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.                              
  26. (define-constant vector->unit!
  27.   (primop vector->unit! ()
  28.     ((primop.generate self node)
  29.      (emit m68/move .b (machine-num header/unit)
  30.            (reg-offset (->register 'pointer node (leaf-value ((call-arg 2) node)) '*)
  31.                        1)))
  32.     ((primop.side-effects? self) t)
  33.     ((primop.type self node)
  34.      '#[type (proc #f (proc #f unit) vector)])))
  35.  
  36. (define-integrable (install-template1 unit code obj i)
  37.   (let ((tp (fx+ (fx* i 4) 6)))
  38.     (set (bref-16 unit (fx- tp 4)) (fx+ tp 2))   ; offset in closure
  39.     (set (bref unit (fx- tp 5)) (bref code (fx- obj 5))) ; scratch
  40.     (set (bref unit (fx- tp 6)) (bref code (fx- obj 6))) ; pointer
  41.     (set (bref unit (fx- tp 2)) (bref code (fx- obj 2))) ; header
  42.     (set (bref unit (fx- tp 1)) (bref code (fx- obj 1))) ; nargs
  43.     (set (bref-16 unit tp) M68-JUMP-ABSOLUTE)            ; jump absolute
  44.     ;++  flush (set (bref-16 unit tp) #x4EF9)
  45.     (set (extend-pointer-elt unit (fx+ i 2))             ; auxiliary template
  46.          (make-pointer code (fixnum-ashr obj 2)))))
  47.